home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / hash.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  2.9 KB  |  113 lines  |  [TEXT/R*ch]
  1. /* The generic hashing primitive */
  2.  
  3. #include "mlvalues.h"
  4. #include "memory.h"
  5. #include "str.h"
  6.  
  7. static unsigned long hash_accu;
  8. static long hash_univ_limit, hash_univ_count;
  9.  
  10. static void hash_aux();
  11.  
  12. value hash_univ_param(count, limit, obj) /* ML */
  13.      value obj, count, limit;
  14. {
  15.   hash_univ_limit = Long_val(limit);
  16.   hash_univ_count = Long_val(count);
  17.   hash_accu = 0;
  18.   hash_aux(obj);
  19.   return Val_long(hash_accu & 0x3FFFFFFF);
  20.   /* The & has two purposes: ensure that the return value is positive
  21.      and give the same result on 32 bit and 64 bit architectures. */
  22. }
  23.  
  24. #define Alpha 65599
  25. #define Beta 19
  26. #define Combine(new)  (hash_accu = hash_accu * Alpha + (new))
  27. #define Combine_small(new) (hash_accu = hash_accu * Beta + (new))
  28.  
  29. static void hash_aux(obj)
  30.      value obj;
  31. {
  32.   unsigned char * p;
  33.   mlsize_t i;
  34.   tag_t tag;
  35.  
  36.   hash_univ_limit--;
  37.   if (hash_univ_count < 0 || hash_univ_limit < 0) return;
  38.  
  39.   if (Is_long(obj)) {
  40.     hash_univ_count--;
  41.     Combine(Long_val(obj));
  42.     return;
  43.   }
  44.  
  45.   /* Atoms are not in the heap, but it's better to hash their tag
  46.      than to do nothing. */
  47.  
  48.   if (Is_atom(obj)) {
  49.     tag = Tag_val(obj);
  50.     hash_univ_count--;
  51.     Combine_small(tag);
  52.     return;
  53.   }
  54.  
  55.   /* Pointers into the heap are well-structured blocks.
  56.      We can inspect the block contents. */
  57.   
  58.   if (Is_in_heap(obj) || Is_young(obj)) {
  59.     tag = Tag_val(obj);
  60.     switch (tag) {
  61.     case String_tag:
  62.       hash_univ_count--;
  63.       i = string_length(obj);
  64.       for (p = &Byte_u(obj, 0); i > 0; i--, p++)
  65.         Combine_small(*p);
  66.       break;
  67.     case Double_tag:
  68.       /* For doubles, we inspect their binary representation, LSB first.
  69.          The results are consistent among all platforms with IEEE floats. */
  70.       hash_univ_count--;
  71. #ifdef MOSML_BIG_ENDIAN
  72.       for (p = &Byte_u(obj, sizeof(double) - 1), i = sizeof(double);
  73.            i > 0;
  74.            p--, i--)
  75. #else
  76.       for (p = &Byte_u(obj, 0), i = sizeof(double);
  77.            i > 0;
  78.            p++, i--)
  79. #endif
  80.         Combine_small(*p);
  81.       break;
  82.     case Abstract_tag:
  83.     case Final_tag:
  84.       /* We don't know anything about the contents of the block.
  85.          Better do nothing. */
  86.       break;
  87.     case Reference_tag:
  88.       /* We can't hash on the heap address itself, since the reference block
  89.          may be moved (from the young generation to the old one).  
  90.      But, we may follow the pointer.  On cyclic structures this will
  91.      terminate because the hash_univ_count gets decremented. */
  92.       Combine_small(tag);
  93.       hash_univ_count--;
  94.       hash_aux(Field(obj, 0));
  95.       break;
  96.     default:
  97.       hash_univ_count--;
  98.       Combine_small(tag);
  99.       i = Wosize_val(obj);
  100.       while (i != 0) {
  101.         i--;
  102.         hash_aux(Field(obj, i));
  103.       }
  104.       break;
  105.     }
  106.     return;
  107.   }
  108.  
  109.   /* Otherwise, obj is a pointer outside the heap, to an object with
  110.      a priori unknown structure. Use its physical address as hash key. */
  111.   Combine((long) obj);
  112. }
  113.